home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 004 / gauss.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-08-07  |  2.8 KB  |  81 lines
  1. 10  '**************************************************************************
  2. 20  '**                                                                      **
  3. 30  '**          LINEAR EQUATION SOLUTION by GAUSSIAN ELIMINATION            **
  4. 40  '**                                                                      **
  5. 50  '**************************************************************************
  6. 60  '
  7. 70  '        A maximum of 20 equations can be handled by this routine
  8. 80  '
  9. 90  '***                     DIMENSION MATRIX                            ***
  10. 100   DIM A(20,21)
  11. 110  CLS:KEY OFF:LOCATE 10,10
  12. 120  '
  13. 130  '***                     INPUT NO. of EQUATIONS                      ***
  14. 140  '
  15. 150  INPUT "Number of Equations, N";N                  ' number of coefficients
  16. 160  LPRINT "Gaussian Elimination Solution for ";N;"equations
  17. 170  PRINT:PRINT
  18. 180  NP1 = N + 1
  19. 190  '
  20. 200  '***                     READ COEFFICIENTS                            ***
  21. 210  '
  22. 220  FOR I=1 TO N                                      ' I = row
  23. 230     FOR J= 1 TO NP1                                ' J = coefficient
  24. 240     PRINT "a(";I;",";J;") = ";:INPUT  A(I,J)
  25. 250     LPRINT "A(";I;",";J;") = ";A(I,J)
  26. 260     NEXT J
  27. 270  NEXT I
  28. 280  '
  29. 290  ' ***                      PRINT HEADING                              ***
  30. 300  '
  31. 310  '
  32. 320  PRINT "Solution to set of ";N;" equations by Gaussian elimination."
  33. 330  LPRINT "Solution to set of ";N;" equations by Gaussian elimination."
  34. 340  '
  35. 350  '***             ELIMINATE COEFFICIENTS BELOW THE DIAGONAL           ***
  36. 360  '
  37. 370  FOR I= 2 TO N
  38. 380     FOR J = I TO N
  39. 390     IF A(I-1,I-1) <>0 THEN 480        'Test if pivot element is zero. If so,
  40. 400     IM1 = I-1                         'switch rows
  41. 410        FOR M = I TO N
  42. 420        IF A(M,IM1) = 0 THEN 460
  43. 430           FOR MM = IM1 TO NP1
  44. 440           SWAP A(M,MM),A(IM1,MM)
  45. 450        NEXT MM
  46. 460     NEXT M
  47. 470     PRINT "Coefficient matrix is singular.  No unique solution to 1set of equations.":GOTO 800
  48. 480     R = A(J,I-1)/A(I-1,I-1)
  49. 490        FOR K= I TO NP1
  50. 500        A(J,K)=A(J,K)-R*A(I-1,K)
  51. 510       IF A(J,K)=0 THEN 470
  52. 520       NEXT K
  53. 530     NEXT J
  54. 540  NEXT I
  55. 550  '                           Back substitute by elimination of coefficients
  56. 560  '                           above diagonal
  57. 570  FOR I = 2 TO N
  58. 580  K = N - I + 2
  59. 590  R = A(K,NP1)/A(K,K)
  60. 600     FOR J = I TO N
  61. 610     L = N - J + 1
  62. 620     A(L,NP1)=A(L,NP1)-R*A(L,K)
  63. 630     NEXT J
  64. 640  NEXT I
  65. 650  '                      Value of variables is column of constants divided by
  66. 660  '                      corresponding  number on  the diagonal.  Compute and
  67. 670  '                      print.
  68. 680  FOR I = 1 TO N
  69. 690  X = A(I,NP1)/A(I,I)
  70. 700  PRINT "X(";I;") = ";X
  71. 710  LPRINT "X(";I;") = ";X
  72. 720  NEXT I
  73. 730  FOR I=1 TO N
  74. 740     FOR J=1 TO N-1
  75. 750     SUM= A(I,J)*X(J)
  76. 760     TOT=SUM +TOT
  77. 770     IF J=N THEN PRINT "A(";I;","N+1;")=";TOT
  78. 780     NEXT J
  79. 790  NEXT I
  80. 800  END
  81.